EnigmA Amiga Run 1997 April/EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso/EARCD/comm/bbs/Hydra11s.lha/HBBS/Source/Oberon/HangUp.mod

Text File | 1996-07-06 | 5KB | 224 lines

MODULE HangUp;

    IMPORT
    a:= Arguments, ac:= ANSIConsole, st:= Strings, cv:= Conversions, io, s:= SYSTEM,
    e:= Exec, d:= Dos, ol:= OberonLib,
    bo:= BBSColours, bs:= BBSStructures, bc:= BBSConstants,
    hn:= HBBSNode, hc:= HBBSCommon, req:= Requests;

    CONST EOF = -1; LF = 0AH;
      LineLength = 80;

    TYPE
    LineNodePtr = UNTRACED POINTER TO LineNode;
    LineNode = STRUCT
        prev, next: LineNodePtr;
        text: ARRAY LineLength OF CHAR;
    END;

    VAR
    BBSGlobal: bs.BBSGlobalDataPtr;
    NnD: bs.NodeDataPtr;
    argList: LineNodePtr;
    argsPool: e.MemPoolPtr;
    CountArgs: INTEGER;
    NodeNum: LONGINT;

    PROCEDURE cleanup(num: LONGINT);
    BEGIN
    IF hn.HBBSNodeBase # NIL THEN
        (* req.BreakPoint("CleanUpDoor"); *)
        hn.HBBSCleanUpDoor;
        (* req.BreakPoint("Close HBBSNodeBase"); *)
        e.CloseLibrary(hn.HBBSNodeBase);
        hn.HBBSNodeBase:= NIL;
    END;
    IF hc.HBBSCommonBase # NIL THEN
        (* req.BreakPoint("CleanUpCommon"); *)
        hc.HBBSCleanUpCommon;
        (* req.BreakPoint("Close HBBSCommonBase"); *)
        e.CloseLibrary(hc.HBBSCommonBase);
        hc.HBBSCommonBase:= NIL;
    END;

    IF num # 0 THEN
        io.WriteString("Door Error = ");
        io.WriteInt(num, 0); io.WriteLn;
         (* io.Format("Door Error = %d\n", s.ADR(num)) *)
    END;
    (* req.BreakPoint("Bye bye"); *)
    END cleanup;

    PROCEDURE init(name: e.STRPTR);
    BEGIN

    (* req.BreakPoint("HBBSCommonBase"); *)
    IF hc.HBBSCommonBase = NIL THEN
        cleanup(1); RETURN
    END;
    (* req.BreakPoint("HBBSInitCommon"); *)
    IF NOT hc.HBBSInitCommon() THEN
        cleanup(2); RETURN
    END;
    (* req.BreakPoint("HBBSNodeBase"); *)
    IF hn.HBBSNodeBase = NIL THEN
        cleanup(3); RETURN
    END;
    (* req.BreakPoint("HBBSInitDoor"); *)
    IF NOT hn.HBBSInitDoor(SHORT(NodeNum), name) THEN
        cleanup(4); RETURN
    END;

    END init;

    PROCEDURE AddNode(VAR list: LineNodePtr; at: INTEGER): LineNodePtr;
    VAR last, new: LineNodePtr;
        dummy: LineNode;
    BEGIN
    new:= e.AllocPooled(argsPool, s.SIZE(dummy));
    IF list = NIL THEN
        IF new # NIL THEN
        new^.prev:= NIL;
        new^.next:= NIL;
        END;
        list:= new;
    ELSE
        IF at <= 1 THEN
        IF new # NIL THEN
            new^.prev:= NIL;
            new^.next:= list;
            list^.prev:= new;
            list:= new;
        END;
        ELSE
        last:= list;
        WHILE (last^.next # NIL) & (at > 2) DO
            last:= last^.next; at:= at - 1
        END;
        IF new # NIL THEN
            new^.next:= last^.next;
            new^.prev:= last;
            IF last^.next # NIL THEN
            last^.next^.prev:= new
            END;
            last^.next:= new;
        END;
        END;
    END;
    RETURN new;
    END AddNode;

    PROCEDURE DeleteNode(VAR list: LineNodePtr; at: INTEGER);
    VAR this: LineNodePtr;
        dummy: LineNode;
    BEGIN
    IF list # NIL THEN
        this:= list;
        IF at <= 1 THEN
        list:= this^.next;
        IF list # NIL THEN list^.prev:= NIL END;
        ELSE
        WHILE (this^.next # NIL) & (at > 1) DO
            this:= this^.next; at:= at - 1
        END;
        IF this^.prev # NIL THEN
            this^.prev^.next:= this^.next
        END;
        IF this^.next # NIL THEN
            this^.next^.prev:= this^.prev;
        END;
        END;
        e.FreePooled(argsPool, this, s.SIZE(dummy));
    END;
    END DeleteNode;

    PROCEDURE GetNode(list: LineNodePtr; at: INTEGER): LineNodePtr;
    BEGIN
    IF list = NIL THEN RETURN NIL END;
    WHILE (list # NIL) & (at > 1) DO
        list:= list^.next; at:= at - 1;
    END;
    RETURN list;
    END GetNode;

    PROCEDURE ReqNumber(l: LONGINT);
    VAR str: ARRAY 80 OF CHAR;
        ok: BOOLEAN;
    BEGIN
    ok:= cv.IntToString(l, str, 10);
    IF ok THEN
        req.BreakPoint(str)
    END;
    END ReqNumber;

    PROCEDURE PutNumber(l: LONGINT);
    VAR str: ARRAY 80 OF CHAR;
        ok: BOOLEAN;
    BEGIN
    ok:= cv.IntToString(l, str, 10);
    IF ok THEN
        hn.PutText(s.ADR(str));
    END;
    END PutNumber;

    PROCEDURE DoorMain;
    BEGIN
    hn.DOORHangUp; (* send ATH0 to force logoff *)
    hn.DOORGoodBye;
    END DoorMain;

    PROCEDURE ParseArgs;
    VAR
        i: INTEGER;
        newArg: LineNodePtr;
        s: ARRAY 80 OF CHAR;
        ok: BOOLEAN;
    BEGIN
    CountArgs:= a.NumArgs();
    i:= 1;
    WHILE i <= CountArgs DO
        newArg:= AddNode(argList, MAX(INTEGER));
        IF newArg # NIL THEN
        a.GetArg(i, newArg^.text);
        ELSE
        CountArgs:= i;
        END;
        i:= i + 1
    END;
    END ParseArgs;

     VAR
     dummy: LineNode;
     nodeNumArg: LineNodePtr;

BEGIN
    argsPool:= e.CreatePool(LONGSET{}, s.SIZE(dummy), s.SIZE(dummy));
    ParseArgs;
    IF CountArgs > 0 THEN
    nodeNumArg:= GetNode(argList, 1);
    IF nodeNumArg # NIL THEN
        IF cv.StringToInt(nodeNumArg^.text, NodeNum) THEN
        init(s.ADR("Logging Off"));
        IF hc.HBBSCommonBase # NIL THEN
            BBSGlobal:= hc.HBBSGimmeBBS();
            IF BBSGlobal # NIL THEN
            NnD:= hc.HBBSNodeDataPtr(SHORT(NodeNum));
            IF NnD # NIL THEN
                DoorMain;
            END;
            END;
        END;
        END;
        cleanup(0);
    ELSE
        io.WriteString("Invalid Param for door")
    END;
    ELSE
    io.WriteString("Invalid / No param for door")
    END;
CLOSE
    cleanup(0);
    e.DeletePool(argsPool);
END HangUp.